home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGASIC / BASFILES.LZH / QBTXINST.BAS < prev    next >
BASIC Source File  |  1988-09-10  |  3KB  |  112 lines
  1. '$INCLUDE:'QBTOOLS.INC'
  2. '' '$INCLUDE: 'qbtools2.inc'
  3. '' '$INCLUDE: 'qbt2indx.inc'
  4. '' '-------------------------Standard Include Merge Section-------------------
  5.  
  6. DEFSNG A-Z
  7.     SUB IndexInsert (IxNum%, Ky$, Mrec%, Xnm$(), Xk$(), Xh%(), sc%) STATIC
  8.  
  9. '  insert a new key into the index
  10. '  use the new method, access the deletions stack.
  11.  
  12.         sc% = 0                                                    ' no success yet
  13.         IF Mrec% < 1 THEN
  14.             sc% = -1
  15.         END IF
  16.         IF LEN(Ky$) < 1 THEN
  17.             sc% = -2
  18.         END IF
  19.  
  20. '  a check is needed to see if the index has grown to it's maximum
  21. '  size. a note here on how to make this index handle records greater
  22. '  than 32767. all the cvi and mki$ routines should be changed to cvs
  23. '  and mks$. also, all refernces to % (where the % is a pointer value
  24. '  in the index) should be changed to ! . the record size will increase
  25. '  as well, because the pointer fields change in length from 2 bytes to
  26. '  4 bytes.
  27.  
  28.         IF Xh%(IxNum%, 2) = 32767 THEN
  29.             sc% = -3
  30.         END IF
  31.  
  32.         IF sc% < 0 THEN
  33.             EXIT SUB
  34.         END IF
  35.  
  36. '  if the length of ky$ is less than the length of the max size for
  37. '  the key, then ky$ will be padded with blanks
  38.  
  39.         IF LEN(Ky$) < Xh%(IxNum%, 1) THEN
  40.             Ky$ = Ky$ + STRING$(Xh%(IxNum%, 1) - LEN(Ky$), 32)
  41.         END IF
  42.         rrec% = 1
  43.         Lp% = 0
  44.  
  45.         WHILE Lp% = 0
  46.             prrec% = rrec%                                          ' hold the recnum for eval
  47.             GET #IxNum%, rrec%
  48.             IF CVI(Xk$(IxNum%, 5)) = 0 THEN
  49.                 GOTO place                                           ' this is where the key goes
  50.             END IF
  51.             IF Ky$ < Xk$(IxNum%, 1) THEN
  52.                 side% = 2
  53.             ELSE
  54.                 side% = 3
  55.             END IF
  56.             rrec% = CVI(Xk$(IxNum%, side%))
  57.             IF rrec% = 0 THEN
  58.                 Lp% = 1                                              ' this is where the key goes
  59.             END IF
  60.         WEND
  61. place:
  62.         IF Xh%(IxNum%, 4) THEN
  63.             Gf% = 4
  64.         ELSE
  65.             Gf% = 3
  66.         END IF
  67.  
  68.         GET #IxNum%, Xh%(IxNum%, Gf%)
  69.         nrec% = CVI(Xk$(IxNum%, 6))
  70.         LSET Xk$(IxNum%, 1) = Ky$
  71.  
  72.         IF Xh%(IxNum%, 3) <> 1 THEN
  73.             GOTO nfirst                                             ' not the first record
  74.         END IF
  75.         LSET Xk$(IxNum%, 4) = MKI$(0)                              ' initialize
  76.         GOTO other
  77. nfirst:
  78.         LSET Xk$(IxNum%, 4) = MKI$(prrec%)
  79. other:
  80.         LSET Xk$(IxNum%, 3) = MKI$(0)
  81.         LSET Xk$(IxNum%, 2) = MKI$(0)
  82.         LSET Xk$(IxNum%, 5) = MKI$(Mrec%)
  83.         LSET Xk$(IxNum%, 6) = MKI$(0)                              ' next deleted
  84.         PUT #IxNum%, Xh%(IxNum%, Gf%)
  85.  
  86.         IF Gf% = 3 THEN
  87.             IF Xh%(IxNum%, 3) = 1 THEN
  88.                 GOTO increment
  89.             END IF
  90.         END IF
  91.  
  92.         GET #IxNum%, prrec%
  93.         LSET Xk$(IxNum%, side%) = MKI$(Xh%(IxNum%, Gf%))
  94.         PUT #IxNum%, prrec%
  95.  
  96. increment:
  97.         IF Gf% = 4 THEN
  98.             Xh%(IxNum%, 4) = nrec%
  99.         ELSE
  100.             Xh%(IxNum%, 4) = 0
  101.             Xh%(IxNum%, 3) = Xh%(IxNum%, 3) + 1
  102.             LSET Xk$(IxNum%, 1) = STRING$(Xh%(IxNum%, 1), 0)
  103.             FOR j% = 2 TO 6
  104.                 LSET Xk$(IxNum%, j%) = MKI$(0)
  105.             NEXT j%
  106.             PUT #IxNum%, Xh%(IxNum%, 3)
  107.         END IF
  108.         Xh%(IxNum%, 2) = Xh%(IxNum%, 2) + 1
  109.         sc% = 1
  110.     END SUB
  111.  
  112.